home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 2 / Tech Arsenal 2 (Arsenal Computer).iso / clipper / s93bsp.exe / CL5 / HOUSE00.PRG < prev    next >
Encoding:
Text File  |  1993-11-26  |  6.6 KB  |  270 lines
  1. ///////////////////////////////////////////////////////////////
  2. //
  3. //  Module : HOUSE00.PRG
  4. //
  5. //  Created by SUMMER'93 (c) on Fri Nov 26 14:50:39 1993
  6. //
  7. ///////////////////////////////////////////////////////////////
  8. #include "snj.ch"
  9. // The following statics were declared 'PUBLIC' in the S87 code
  10. // OR were private and inherited by called functions
  11. // If they are used outside this module there will be a set/get
  12. // function with the same name as the var in this module
  13. static DBREC, DBNAME
  14. procedure HOUSEMAIN
  15. // Calls: QBLAYOUT QBBOX QBMENU CTEDIT BODARCH BODREST 
  16. // Called By: BODYWORK 
  17. //       H O U S E 0 0
  18. //       Main controlling routine for Housekeeping
  19. local HSCOM, OLDMLIN, RTITLE, RCHOIX
  20.  
  21. QBCHOICE( 1  )
  22. do while .t. 
  23.     //    Last change:  MIB  26 Oct 93    5:51 pm
  24.  
  25.     close database 
  26.     do QBLAYOUT with "Housekeeping" 
  27.     do QBBOX with 40 
  28.     do QBMENU with "HOUSEKE", 40 
  29.     RTITLE := QBPROC() 
  30.     RCHOIX := QBCHOICE() 
  31.     do case 
  32.         case RCHOIX  = 0 .or. RCHOIX  = 5 
  33.             exit 
  34.         case RCHOIX  = 1 
  35.             do QBLAYOUT with RTITLE 
  36.             do CTEDIT with 5, 19, 15, 1 
  37.         case RCHOIX  = 2 
  38.             do QBLAYOUT with RTITLE 
  39.             do QBBOX with 40 
  40.         case RCHOIX  = 3 
  41.             do QBLAYOUT with RTITLE 
  42.             do QBBOX with 40 
  43.             do BODARCH
  44.         case RCHOIX  = 4 
  45.             do QBLAYOUT with RTITLE 
  46.             do QBBOX with 40 
  47.             do BODREST
  48.     endcase 
  49.     QBCHOICE( RCHOIX  )
  50. enddo 
  51. set softseek off 
  52. return 
  53.  
  54. //******************************************************************
  55.  
  56. procedure BODARCH
  57. // Calls: QB2DATES QBMESS QBYESNO DRIVEOK GETREC PUTREC QBWIPE QBCLMESS 
  58. // Called By: HOUSEMAIN 
  59. //   B O D A R C H . P R G
  60. //  Program to archive Invoices
  61. // The following locals have been declared by Summer'93
  62. // ADATE 
  63. local status, D1, D2, ADATE
  64.  
  65. status := 0 
  66. D1 := D2 := ctod("" )
  67.  
  68. select 0 
  69. use PARTS index PARTINV alias PARTS 
  70. select 0 
  71. use INVOICE index INVDATE, INVNUM, INVCUST alias INVOICE 
  72.  
  73. // Method: Create structure on Disc a:
  74. ADATE := date( )
  75.  
  76. @ 5, 26 say " First date: " 
  77. @ 7, 26 say "Second date: " 
  78. do QB2DATES with "Input Start and Finish dates", 5, 39, D1, 7, 39, D2 
  79.  
  80. set softseek on 
  81. seek dtos( D1 )
  82. if eof( )
  83.     do QBMESS with "No Invoices to be archived", COLFLASH() , 5 
  84.     return 
  85. endif 
  86.  
  87. if QBYESNO( "OK to Continue?" ) = "N" .or. GETOUT() 
  88.     close database 
  89.     return 
  90. endif 
  91.  
  92. do QBMESS with "Place a formatted floppy in drive A", COLHEAD() , 0 
  93. if !DRIVEOK( )
  94.     GETOUT( .f.  )
  95.     return 
  96. endif 
  97. do QBMESS with "Selecting Invoices", COLFLASH() , 0 
  98.  
  99.  
  100. do QBMESS with "Archiving Invoices and Parts to Floppy", COLFLASH() , 0 
  101.  
  102. // Create Files on Floppy
  103. select INVOICE 
  104. copy structure to A:INVOICE 
  105. select PARTS 
  106. copy structure to A:PARTS 
  107. select 0 
  108. use A:PARTS alias APARTS 
  109. select 0 
  110. use A:INVOICE alias ANVOICE 
  111.  
  112. go top 
  113. select INVOICE 
  114. set softseek on  // Invoices
  115. seek dtos( D1 )
  116. do while INVOICE->DATEINV <= D2 .and.  !eof( )
  117.     GETREC( ) // Get the current record in the database
  118.     select ANVOICE 
  119.     PUTREC( ) // Put it in the other
  120.     MINVNO( ANVOICE->INVNO  )  // Get a number from A drive
  121.  
  122.     set softseek off  // Part by Invoice #
  123.     select PARTS 
  124.     seek str( MINVNO() , 5 ) // Find in main file
  125.     do while !eof( ).and. MINVNO()  = PARTS->INVNO 
  126.         GETREC( )
  127.         select APARTS 
  128.         PUTREC( )
  129.         select PARTS 
  130.         do QBWIPE
  131.         seek str( MINVNO() , 5 ) // Find in main file
  132.     enddo 
  133.  
  134.     set softseek on  // Erase Invoice, Get next
  135.     select INVOICE 
  136.     do QBWIPE
  137.     seek dtos( D1 )
  138. enddo 
  139.  
  140. do QBCLMESS
  141. close database 
  142. do QBMESS with "Remove floppy from drive A: and label it", COLHEAD() , 0 
  143. wait 
  144. set softseek off 
  145.  
  146. do QBCLMESS
  147. return 
  148.  
  149. //******************************************************************
  150. function GETREC
  151. // Calls: 
  152. // Called By: BODARCH 
  153. local NUMFLDS, T, I
  154.  
  155. NUMFLDS := fcount( )
  156. DBREC := array(  NUMFLDS  )
  157. DBNAME := array(  NUMFLDS  )
  158.  
  159. afields( DBNAME )
  160. for I := 1 to NUMFLDS 
  161.     T := DBNAME[ I ] 
  162.     DBREC[ I ] := &T 
  163. next 
  164.  
  165. BLIMEMPAK(  - 1 )
  166.  
  167. return .t. 
  168.  
  169. //******************************************************************
  170. function PUTREC
  171. // Calls: 
  172. // Called By: BODARCH 
  173. local NUMFLDS, T, I
  174.  
  175. NUMFLDS := fcount( )
  176.  
  177. append blank 
  178. afields( DBNAME )
  179. for I := 1 to NUMFLDS 
  180.     T := DBNAME[ I ] 
  181.     replace &T with DBREC[ I ] 
  182. next 
  183.  
  184. BLIMEMPAK(  - 1 )
  185.  
  186. return .t. 
  187.  
  188. //******************************************************************
  189.  
  190. procedure BODREST
  191. // Calls: QBYESNO QBMESS DRIVEOK 
  192. // Called By: HOUSEMAIN 
  193. //   B O D R E S T
  194. local status
  195.  
  196. status := 0 
  197. select 0 
  198. use INVOICE index INVNUM, INVDATE, INVCUST 
  199. select 0 
  200. use PARTS index PARTINV 
  201.  
  202. @ 5, 26 say "Restoring Invoices" 
  203.  
  204. if QBYESNO( "OK to Continue?" ) = "N" 
  205.     close database 
  206.     return 
  207. endif 
  208.  
  209. do while .t. 
  210.     do QBMESS with "Place the Archive floppy in drive A", COLHEAD() , 0 
  211.     if !DRIVEOK( )
  212.         GETOUT( .f.  )
  213.         return 
  214.     endif 
  215.     if file( "a:invoice.dbf" ).and. file( "a:parts.dbf" )
  216.         do QBMESS with "Appending Invoices from Floppy", COLHEAD() , 0 
  217.         select INVOICE 
  218.         append from A:INVOICE 
  219.         select PARTS 
  220.         append from A:PARTS 
  221.         exit 
  222.     else 
  223.         do QBMESS with "Floppy does not contain correct files - try again",  ;
  224.         COLFLASH() , 5 
  225.         if QBYESNO( "OK to try again?" ) = "N" 
  226.             close database 
  227.             return 
  228.         endif 
  229.     endif 
  230. enddo 
  231. do QBMESS with "Reindexing Invoices", COLHEAD() , 0 
  232. select INVOICE 
  233. index on str( FIELD->INVNO , 5 )to INVNUM 
  234. index on dtos( FIELD->DATEOUT ) + FIELD->CUSTTYPE to INVDATE 
  235. index on FIELD->CUSTTYPE  + dtos( FIELD->DATEOUT )to INVCUST 
  236. index on upper( FIELD->OWNNAME )to INVNAME 
  237.  
  238. select PARTS 
  239. index on str( FIELD->INVNO , 5 ) + str( FIELD->PLINENO , 2 )to PARTINV 
  240.  
  241. do QBMESS with "Remove floppy from drive A: ", COLHEAD() , 0 
  242. wait 
  243.  
  244. close database 
  245.  
  246. return 
  247.  
  248. //******************************************************************
  249.  
  250.  
  251. //******************************************************************
  252. function DRIVEOK
  253. // Calls: ISDRIVE QBPROMPT 
  254. // Called By: BODARCH BODREST 
  255. // The following locals have been declared by Summer'93
  256. // ACTION 
  257. local ACTION
  258. GETOUT( .f.  )
  259. do while !ISDRIVE( "A" )
  260.     ACTION := QBPROMPT( "Continue|Quit|", ;
  261.     "Floppy is not ready - correct and continue or Quit", 1 )
  262.     if ACTION <> 1 
  263.         GETOUT( .t.  )
  264.         exit 
  265.     endif 
  266. enddo 
  267.  
  268. return !GETOUT() 
  269. // End of file
  270.